home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0127_Knights Tour.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  8KB  |  314 lines
  1. PROGRAM Knight;
  2.  
  3. {Knight's tour calcualtor. 
  4.  
  5. This program will compute a knight's tour of a chess board. A knight's tour
  6. is a knight visiting each square of the chessboard only once by making his
  7. normal move.
  8.  
  9. The main logic of this program is a recursive routine that keeps trying every
  10. possible move from every possible position until a full tour is completed.
  11.  
  12. If a successful completion is realized, the board will display the sequence
  13. of moves that must be made to complete the tour. If a successful completion
  14. is not possible from the chosed starteing place, the board will be blank.
  15.  
  16. If the DEBUG variable is defined, the starting place will always be row one, 
  17. column one, which is the upper left corner of the board. Otherwise a random
  18. starting place is selected.
  19.  
  20. On a full size 8 x 8 square chessboard, this program runs about forever. To
  21. limit the size of the board, change the BoardSize constant and recompile the 
  22. program. To halt the execution of the program, press "Q".
  23.  
  24. This program uses Object Professional's FastWrite procedure to greatly speed
  25. up its screen writing. To compile without Object Professional, delete the }
  26.  
  27.                              {$DEFINE USEOPRO}
  28.  
  29. {definition above. The executable program included here was compiled using
  30. Turbo Pascal version 6.0, but the program should compile with 5.x. It was 
  31. compiled using the Object Professional routines, but without the DEBUG
  32. variable set. 
  33.  
  34.  
  35.  
  36. Written by:
  37.  
  38.             J Russell Jones
  39.             4440 Gunnison 
  40.             Wichita KS 67220
  41.  
  42.             GEnie: JJONES20
  43.  
  44. This program is hereby placed in the public domain.}
  45.  
  46.  
  47.  
  48. {$A-,B-,F-,G-,O+,V-,X-,N-,E-}
  49.  
  50. {$IFDEF DEBUG}
  51. {$D+,I+,L+,R+,S+}
  52. {$ELSE}
  53. {$D-,I-,L-,R-,S-}
  54. {$ENDIF}
  55.  
  56.  
  57.  
  58. USES
  59.   {$IFDEF USEOPRO}
  60.   OpCrt;
  61.   {$ELSE}
  62.   Crt;
  63.   {$ENDIF}
  64.  
  65.  
  66. CONST
  67.   BoardSize     = 8;  {Limits the size of the chess board}
  68.   DoneCount     = BoardSize * BoardSize;
  69.  
  70.  
  71. TYPE
  72.   BoardTyp  = ARRAY[1..BoardSize,1..BoardSize] OF BYTE;
  73.  
  74.  
  75. VAR
  76.   Board         : BoardTyp;
  77.   Row,
  78.   Col,
  79.   FilledSpaces  : INTEGER;
  80.   LongCount     : LONGINT;
  81.  
  82.  
  83. PROCEDURE InitBoard(VAR Board : BoardTyp; VAR FilledSpaces : INTEGER);
  84.  
  85.   {Set the game board to all zeros}
  86.  
  87.   VAR
  88.     i,j   : INTEGER;
  89.  
  90.   BEGIN {InitBoard}
  91.     FilledSpaces := 0; 
  92.     FOR i := 1 TO BoardSize DO
  93.       FOR j := 1 TO BoardSize DO
  94.         Board[i,j] := 0;
  95.   END; {InitBoard}
  96.  
  97.  
  98. FUNCTION AdjustKnight (Row,Col,Which : INTEGER;
  99.                        VAR NewRow,NewCol : INTEGER) : BOOLEAN;
  100.  
  101.   {Adjust knight's position - return false if new position is off the 
  102.   board or has already been occupied}
  103.  
  104.  
  105.   BEGIN {AdjustKnight}
  106.  
  107.     CASE Which OF 
  108.       1,2 : NewRow := Row - 2;
  109.       8,3 : NewRow := Row - 1;
  110.       7,4 : NewRow := Row + 1;
  111.       6,5 : NewRow := Row + 2;
  112.     END; {case}
  113.  
  114.     CASE Which OF 
  115.       8,7 : NewCol := Col - 2;
  116.       1,6 : NewCol := Col - 1;
  117.       2,5 : NewCol := Col + 1;
  118.       3,4 : NewCol := Col + 2;
  119.     END;
  120.  
  121.     AdjustKnight := FALSE;
  122.  
  123.     IF (NewRow >= 1) AND (NewRow <= BoardSize) AND 
  124.        (NewCol >= 1) AND (NewCol <= BoardSize) THEN
  125.       IF Board[NewRow,NewCol] = 0 THEN
  126.         AdjustKnight := TRUE;
  127.  
  128.  
  129.   END; {AdjustKnight}
  130.  
  131.  
  132. PROCEDURE ClearScreen;
  133.  
  134.   {Clear the screen and display a blank chess board}
  135.  
  136.   BEGIN {ClearScreen}
  137.     ClrScr;
  138.  
  139.     {$IFDEF USEOPRO}
  140.  
  141.     FastText('Moves attempted:',1,5);
  142.     FastText('┌────┬────┬────┬────┬────┬────┬────┬────┐',3,5);
  143.     FastText('│    │    │    │    │    │    │    │    │',4,5);
  144.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',5,5);
  145.     FastText('│    │    │    │    │    │    │    │    │',6,5);
  146.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',7,5);
  147.     FastText('│    │    │    │    │    │    │    │    │',8,5);
  148.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',9,5);
  149.     FastText('│    │    │    │    │    │    │    │    │',10,5);
  150.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',11,5);
  151.     FastText('│    │    │    │    │    │    │    │    │',12,5);
  152.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',13,5);
  153.     FastText('│    │    │    │    │    │    │    │    │',14,5);
  154.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',15,5);
  155.     FastText('│    │    │    │    │    │    │    │    │',16,5);
  156.     FastText('├────┼────┼────┼────┼────┼────┼────┼────┤',17,5);
  157.     FastText('│    │    │    │    │    │    │    │    │',18,5);
  158.     FastText('└────┴────┴────┴────┴────┴────┴────┴────┘',19,5);
  159.  
  160.     {$ELSE}
  161.  
  162.     GotoXY(5,1);
  163.     WriteLn('Moves attempted:');
  164.     WriteLn;
  165.     WriteLn('    ┌────┬────┬────┬────┬────┬────┬────┬────┐');
  166.     WriteLn('    │    │    │    │    │    │    │    │    │');
  167.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  168.     WriteLn('    │    │    │    │    │    │    │    │    │');
  169.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  170.     WriteLn('    │    │    │    │    │    │    │    │    │');
  171.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  172.     WriteLn('    │    │    │    │    │    │    │    │    │');
  173.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  174.     WriteLn('    │    │    │    │    │    │    │    │    │');
  175.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  176.     WriteLn('    │    │    │    │    │    │    │    │    │');
  177.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  178.     WriteLn('    │    │    │    │    │    │    │    │    │');
  179.     WriteLn('    ├────┼────┼────┼────┼────┼────┼────┼────┤');
  180.     WriteLn('    │    │    │    │    │    │    │    │    │');
  181.     WriteLn('    └────┴────┴────┴────┴────┴────┴────┴────┘');
  182.  
  183.     {$ENDIF}
  184.  
  185.   END; {ClearScreen} 
  186.  
  187.  
  188. PROCEDURE PlotPosition(Row,Col,FilledSpaces : INTEGER; Show : BOOLEAN);
  189.  
  190.   {Show or clear the specified position on the chess board}
  191.  
  192.   VAR
  193.     s : STRING[4];
  194.  
  195.   BEGIN
  196.  
  197.     {$IFDEF USEOPRO}
  198.  
  199.     IF Show THEN
  200.       Str(FilledSpaces:3,s)
  201.     ELSE
  202.       s := '   ';
  203.     FastText(s,Row * 2 + 2,Col * 5 + 1);
  204.  
  205.     {$ELSE}
  206.  
  207.     GotoXY(Col * 5 + 1,Row * 2 + 2);
  208.     IF Show THEN
  209.       Write(FilledSpaces:3)
  210.     ELSE
  211.       Write('   ');
  212.  
  213.     {$ENDIF}
  214.  
  215.   END; {PlotPosition}
  216.  
  217.  
  218. PROCEDURE KnightsTour (Row,Col : INTEGER; VAR Board : BoardTyp;
  219.                        VAR FilledSpaces : INTEGER);
  220.  
  221.   VAR
  222.     s             : STRING[32];
  223.     Which,
  224.     NewRow,
  225.     NewCol        : INTEGER;
  226.     ch            : CHAR;
  227.   
  228.   BEGIN
  229.  
  230.     IF KeyPressed THEN
  231.       BEGIN
  232.         ch := ReadKey;
  233.         IF (ch = 'Q') OR (ch = 'q') THEN
  234.           BEGIN
  235.             GotoXY(1,22);
  236.             {$IFDEF USEOPRO}
  237.             NormalCursor;
  238.             {$ENDIF}
  239.             Halt;
  240.           END
  241.       END;
  242.  
  243.     Inc(LongCount);
  244.  
  245.     {$IFDEF USEOPRO}
  246.  
  247.     Str(LongCount,s);
  248.     FastText(s,1,22);
  249.  
  250.     {$ELSE}
  251.  
  252.     GotoXY(22,1);
  253.     Write(LongCount);
  254.  
  255.     {$ENDIF}
  256.  
  257.  
  258.     Inc(FilledSpaces);
  259.     Board[Row,Col] := FilledSpaces;
  260.     PlotPosition(Row,Col,FilledSpaces,TRUE);
  261.  
  262.     Which := 0;
  263.       
  264.     WHILE ((FilledSpaces < DoneCount) AND (Which < 8)) DO
  265.       BEGIN
  266.  
  267.         Inc(Which);
  268.  
  269.         IF AdjustKnight(Row,Col,Which,NewRow,NewCol) THEN
  270.           KnightsTour(NewRow,NewCol,Board,FilledSpaces);
  271.  
  272.       END; {while}
  273.  
  274.     IF (Which = 8) THEN
  275.       BEGIN
  276.         Dec(FilledSpaces);
  277.         PlotPosition(Row,Col,FilledSpaces,FALSE);
  278.         Board[Row,Col] := 0;
  279.       END; {if}
  280.  
  281.   END; {KnightTour}
  282.  
  283.  
  284. BEGIN {Main Program}
  285.  
  286.   Randomize;
  287.  
  288.   {$IFDEF USEOPRO}
  289.   HiddenCursor;
  290.   {$ENDIF}
  291.  
  292.   InitBoard(Board,FilledSpaces);
  293.   ClearScreen;
  294.  
  295.   Row := Random(BoardSize - 1) + 1;
  296.   Col := Random(BoardSize - 1) + 1;
  297.  
  298.   {$IFDEF DEBUG}
  299.   Row := 1;
  300.   Col := 1;
  301.   {$ENDIF}
  302.  
  303.   LongCount := 0;
  304.   KnightsTour(Row,Col,Board,FilledSpaces);
  305.  
  306.   GotoXY(1,22);
  307.  
  308.   {$IFDEF USEOPRO}
  309.   NormalCursor;
  310.   {$ENDIF}
  311.  
  312.  
  313. END.
  314.